home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / mac / tclMacLoad.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  6.7 KB  |  236 lines  |  [TEXT/CWIE]
  1. /*
  2.  * tclMacLoad.c --
  3.  *
  4.  *    This procedure provides a version of the TclLoadFile for use
  5.  *    on the Macintosh.  This procedure will only work with systems 
  6.  *    that use the Code Fragment Manager.
  7.  *
  8.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * SCCS: @(#) tclMacLoad.c 1.18 96/12/12 19:30:22
  14.  */
  15.  
  16. #include <CodeFragments.h>
  17. #include <Errors.h>
  18. #include <Resources.h>
  19. #include <Strings.h>
  20. #include <FSpCompat.h>
  21. #include "tclPort.h"
  22. #include "tclInt.h"
  23. #include "tclMacInt.h"
  24.  
  25. #if GENERATINGPOWERPC
  26.     #define OUR_ARCH_TYPE kPowerPCCFragArch
  27. #else
  28.     #define OUR_ARCH_TYPE kMotorola68KCFragArch
  29. #endif
  30.  
  31. /*
  32.  * The following data structure defines the structure of a code fragment
  33.  * resource.  We can cast the resource to be of this type to access
  34.  * any fields we need to see.
  35.  */
  36. struct CfrgHeader {
  37.     long     res1;
  38.     long     res2;
  39.     long     version;
  40.     long     res3;
  41.     long     res4;
  42.     long     filler1;
  43.     long     filler2;
  44.     long     itemCount;
  45.     char    arrayStart;    /* Array of externalItems begins here. */
  46. };
  47. typedef struct CfrgHeader CfrgHeader, *CfrgHeaderPtr, **CfrgHeaderPtrHand;
  48.  
  49. /*
  50.  * The below structure defines a cfrag item within the cfrag resource.
  51.  */
  52. struct CfrgItem {
  53.     OSType     archType;
  54.     long     updateLevel;
  55.     long    currVersion;
  56.     long    oldDefVersion;
  57.     long    appStackSize;
  58.     short    appSubFolder;
  59.     char    usage;
  60.     char    location;
  61.     long    codeOffset;
  62.     long    codeLength;
  63.     long    res1;
  64.     long    res2;
  65.     short    itemSize;
  66.     Str255    name;        /* This is actually variable sized. */
  67. };
  68. typedef struct CfrgItem CfrgItem;
  69.  
  70. /*
  71.  *----------------------------------------------------------------------
  72.  *
  73.  * TclLoadFile --
  74.  *
  75.  *    This procedure is called to carry out dynamic loading of binary
  76.  *    code for the Macintosh.  This implementation is based on the
  77.  *    Code Fragment Manager & will not work on other systems.
  78.  *
  79.  * Results:
  80.  *    The result is TCL_ERROR, and an error message is left in
  81.  *    interp->result.
  82.  *
  83.  * Side effects:
  84.  *    New binary code is loaded.
  85.  *
  86.  *----------------------------------------------------------------------
  87.  */
  88.  
  89. int
  90. TclLoadFile(
  91.     Tcl_Interp *interp,        /* Used for error reporting. */
  92.     char *fileName,        /* Name of the file containing the desired
  93.                  * code. */
  94.     char *sym1, char *sym2,    /* Names of two procedures to look up in
  95.                  * the file's symbol table. */
  96.     Tcl_PackageInitProc **proc1Ptr,
  97.     Tcl_PackageInitProc **proc2Ptr)
  98.                 /* Where to return the addresses corresponding
  99.                  * to sym1 and sym2. */
  100. {
  101.     ConnectionID connID;
  102.     Ptr dummy;
  103.     OSErr err;
  104.     SymClass symClass;
  105.     FSSpec fileSpec;
  106.     short fragFileRef, saveFileRef;
  107.     Handle fragResource;
  108.     UInt32 offset = 0;
  109.     UInt32 length = kWholeFork;
  110.     char packageName[255];
  111.     Str255 errName;
  112.     
  113.     /*
  114.      * First thing we must do is infer the package name from the sym1
  115.      * variable.  This is kind of dumb since the caller actually knows
  116.      * this value, it just doesn't give it to us.
  117.      */
  118.     strcpy(packageName, sym1);
  119.     *packageName = (char) tolower(*packageName);
  120.     packageName[strlen(packageName) - 5] = NULL;
  121.     
  122.     err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
  123.     if (err != noErr) {
  124.     interp->result = "could not locate shared library";
  125.     return TCL_ERROR;
  126.     }
  127.     
  128.     /*
  129.      * See if this fragment has a 'cfrg' resource.  It will tell us were
  130.      * to look for the fragment in the file.  If it doesn't exist we will
  131.      * assume we have a ppc frag using the whole data fork.  If it does
  132.      * exist we find the frag that matches the one we are looking for and
  133.      * get the offset and size from the resource.
  134.      */
  135.     saveFileRef = CurResFile();
  136.     SetResLoad(false);
  137.     fragFileRef = FSpOpenResFile(&fileSpec, fsRdPerm);
  138.     SetResLoad(true);
  139.     if (fragFileRef != -1) {
  140.     UseResFile(fragFileRef);
  141.     fragResource = Get1Resource(kCFragResourceType, kCFragResourceID);
  142.     HLock(fragResource);
  143.     if (ResError() == noErr) {
  144.         CfrgItem* srcItem;
  145.         long itemCount, index;
  146.         Ptr itemStart;
  147.  
  148.         itemCount = (*(CfrgHeaderPtrHand)fragResource)->itemCount;
  149.         itemStart = &(*(CfrgHeaderPtrHand)fragResource)->arrayStart;
  150.         for (index = 0; index < itemCount;
  151.          index++, itemStart += srcItem->itemSize) {
  152.         srcItem = (CfrgItem*)itemStart;
  153.         if (srcItem->archType != OUR_ARCH_TYPE) continue;
  154.         if (!strncasecmp(packageName, (char *) srcItem->name + 1,
  155.             srcItem->name[0])) {
  156.             offset = srcItem->codeOffset;
  157.             length = srcItem->codeLength;
  158.         }
  159.         }
  160.     }
  161.     /*
  162.      * Close the resource file.  If the extension wants to reopen the
  163.      * resource fork it should use the tclMacLibrary.c file during it's
  164.      * construction.
  165.      */
  166.     HUnlock(fragResource);
  167.     ReleaseResource(fragResource);
  168.     CloseResFile(fragFileRef);
  169.     UseResFile(saveFileRef);
  170.     }
  171.  
  172.     /*
  173.      * Now we can attempt to load the fragement using the offset & length
  174.      * obtained from the resource.  We don't worry about the main entry point
  175.      * as we are going to search for specific entry points passed to us.
  176.      */
  177.     
  178.     c2pstr(packageName);
  179.     err = GetDiskFragment(&fileSpec, offset, length, (StringPtr) packageName,
  180.         kLoadLib, &connID, &dummy, errName);
  181.     if (err != fragNoErr) {
  182.     p2cstr(errName);
  183.     Tcl_AppendResult(interp, "couldn't load file \"", fileName,
  184.         "\": ", errName, (char *) NULL);
  185.     return TCL_ERROR;
  186.     }
  187.     
  188.     c2pstr(sym1);
  189.     err = FindSymbol(connID, (StringPtr) sym1, (Ptr *) proc1Ptr, &symClass);
  190.     p2cstr((StringPtr) sym1);
  191.     if (err != fragNoErr || symClass == kDataCFragSymbol) {
  192.     interp->result =
  193.         "could not find Initialization routine in library";
  194.     return TCL_ERROR;
  195.     }
  196.  
  197.     c2pstr(sym2);
  198.     err = FindSymbol(connID, (StringPtr) sym2, (Ptr *) proc2Ptr, &symClass);
  199.     p2cstr((StringPtr) sym2);
  200.     if (err != fragNoErr || symClass == kDataCFragSymbol) {
  201.     *proc2Ptr = NULL;
  202.     }
  203.     
  204.     return TCL_OK;
  205. }
  206.  
  207. /*
  208.  *----------------------------------------------------------------------
  209.  *
  210.  * TclGuessPackageName --
  211.  *
  212.  *    If the "load" command is invoked without providing a package
  213.  *    name, this procedure is invoked to try to figure it out.
  214.  *
  215.  * Results:
  216.  *    Always returns 0 to indicate that we couldn't figure out a
  217.  *    package name;  generic code will then try to guess the package
  218.  *    from the file name.  A return value of 1 would have meant that
  219.  *    we figured out the package name and put it in bufPtr.
  220.  *
  221.  * Side effects:
  222.  *    None.
  223.  *
  224.  *----------------------------------------------------------------------
  225.  */
  226.  
  227. int
  228. TclGuessPackageName(
  229.     char *fileName,        /* Name of file containing package (already
  230.                  * translated to local form if needed). */
  231.     Tcl_DString *bufPtr)    /* Initialized empty dstring.  Append
  232.                  * package name to this if possible. */
  233. {
  234.     return 0;
  235. }
  236.